home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / C64 / A-Monthly Disks / (c)abe.d64 / dbase64.v1 (.txt) < prev    next >
Commodore BASIC  |  2007-02-04  |  18KB  |  493 lines
  1. 0 UD$="N":PRINT"[147]  *** DBASE64.V1 BY R.JACOBS 2/88 **"
  2. 5 PRINT"ARE YOU USING A DISK DRIVE (Y/N)":INPUTUD$
  3. 130 WQ$="CLOSE THE FILE NOW?   Y[146] CLOSE IT  F1[146] NO"
  4. 140 CP=2:IFUD$="Y"THEN OPEN15,8,15:PRINT#15,"UJ"
  5. 150 IFCP=1ANDUD$="Y"THENPRINT#15,"UI-"
  6. 160 M2$="  [146]C [146]D [146]G [146]H [146]I [146]M [146]P [146]R [146]S [146]X [146]F1 "
  7. 162 M3$="    [146]@@@ QUITS     [146]":X1=1:X2=1:C6=0:C1=0:C4=0:C7=0
  8. 170 M1$="REC. NO.:[146]":M4$=" [146]G  [146]P  [146]H  [146]X  [146]F1   [146]"
  9. 180 PRINT"[147]     DBASE64.V1   [146]   BY DICK JACOBS[146]"
  10. 190 PRINT" 1[146]-CREATE NEW FILE  11[146]-BYTES FREE"
  11. 200 PRINT" 2[146]-ADD MORE RECORDS 12[146]-RENAME FIELDS"
  12. 210 PRINT" 3[146]-SORT RECORDS     13[146]-CLOSE FILE  "
  13. 220 PRINT" 4[146]-EDIT RECORDS     14[146]-INDEX FILE"
  14. 230 PRINT" 5[146]-SAVE FILE        15[146]-DISK DIRECTORY"
  15. 240 PRINT" 6[146]-LOAD FILE        16[146]-DISK STATUS"
  16. 250 PRINT" 7[146]-BREAK PROGRAM    17[146]-SET COLORS"
  17. 260 PRINT" 8[146]-PRINT RECORDS    18[146]-DISK COMMANDS"
  18. 270 PRINT" 9[146]-SEARCH & SUM     19[146]-CONFIG SYS"
  19. 280 PRINT"10[146]-SUM A FIELD      20[146]-HELP":PRINT
  20. 290 IFC1ORC4ORC6THENPRINT" CAUTION: FILE OPEN[146]"
  21. 300 IFUD$="Y"THENPRINT"COMMAND CHANNEL OPEN[146]"
  22. 305 PRINT"FILE DIMENSIONS: ";LK+1;"[146] X  ";KL;"[146]RECS."
  23. 310 PRINT"NO. OF RECORDS IN CURRRENT FILE:[146]";B
  24. 320 PRINT"ENTER A COMMAND (1-20):[146]";:INPUTC:IFC>25THEN180
  25. 330 IF C>16GOTO360
  26. 340 ONCGOSUB380,420,2020,1180,810,1800,2010,1410,610,550,1990,2530,2440,3100,2730,2960
  27. 350 GOTO180
  28. 360 ON C-16GOSUB3520,3650,4500,4700
  29. 370 GOTO180
  30. 380 IFY=1THENRETURN
  31. 390 PRINT"[147]":GOSUB2350:Y=1:B=1:N=LK:      GOTO410:REMPRINT"CREATE FILE[146]"
  32. 400 PRINT"CREATE HOW MANY FIELDS":INPUTN:N=N-1
  33. 410 PRINT"[147]":FORA=0TON:PRINT"ENTER NAME FOR FIELD[146]";A  :INPUTFF$(A):NEXTA
  34. 420 IF Y<>1THENRETURN
  35. 430 GOSUB2320:PRINT"BEGIN ENTERING YOUR RECORDS.  TYPE @@@[146]";
  36. 432 PRINT"  IN FIRST FIELD TO STOP":A=0
  37. 434 IFX2=1THENPRINT"INPUT DEFAULT IS COPY PREVIOUS FIELD[146]"
  38. 436 IFX2=2THENPRINT"INPUT DEFAULT IS BLANK ON RETURN[146]"
  39. 440 IFB>1THENGOSUB4000:PRINT"PREV. REC":PRINT:FORA=0TON:PRINTF$(A,B-1):NEXTA:A=0
  40. 450 PRINT"                                       "
  41. 451 PRINT"                                       "
  42. 452 PRINT"                                       [145][145][145]":PRINT
  43. 453 PRINTM1$;B;M3$:PRINT
  44. 457 IFB=>KL-1THENPRINT"  ARRAY FULL  -  SAVE FILE[146]":FORA=1TO12:GOSUB510:NEXTA
  45. 460 IF B=>KL-1THENA=0:F$(A,B)="@@@":RETURN
  46. 470 IFA>NTHEN500
  47. 480 IFX2=1THENF$(A,B)=F$(A,B-1)
  48. 481 IFX2=2THENF$(A,B)="."
  49. 482 PRINT"";FF$(A);"[146]";:INPUTF$(A,B):IFF$(0,B)="@@@"THENRETURN
  50. 490 A=A+1:GOTO470
  51. 500 A=0:B=B+1:PRINT:GOSUB510:GOTO450
  52. 510 IFCP=1THENPOKEVL,15:POKEVO,245:FORO=1TO20:NEXTO:POKEVL,0:POKEVO,0:RETURN
  53. 520 POKE54272+24,15:POKE54272+2,255:POKE54272+3,0:POKE54272+5,9
  54. 530 POKE54272+6,0:POKE54272+1,18:POKE54272,104:POKE54272+4,65
  55. 540 FORO=1TO50:NEXTO:POKE54272+4,64:FORO=1TO50:NEXTO:RETURN
  56. 550 IF Y<>1THENRETURN
  57. 560 GOSUB2320:INPUT"SUM FD #";U:IFU>NTHENGOSUB5000:GOTO560
  58. 563 T=0:PRINT"[147]":FORD=1TOB-1:T=T+VAL(F$(U,D))
  59. 570 PRINT"RECORD #:";D;"          "
  60. 580 PRINT"VALUE   : ";VAL(F$(U,D));"SUMMATION                   "
  61. 590 PRINT"SUMMATION ";T:NEXT
  62. 600 QX$="[157][157]        ":GOSUB2410:RETURN
  63. 610 IF Y<>1THENRETURN
  64. 620 GOSUB2320:INPUT"SEARCH FOR";R$:INPUT"SEARCH FIELD";F1
  65. 622 IFF1>NTHENGOSUB5000:GOTO620
  66. 630 INPUT"FIELD TO SUM? OR ENTER 99[146] TO BYPASS SUM.";U
  67. 633 QX$="SEARCH":GOSUB2410:IFA$<>"Y"THENRETURN
  68. 640 PRINT"[147]SEARCHING FOR[146]         ";R$;"ON REC #:MATCHES FOUND:"
  69. 650 T=0:F=0:FORS=1TOB-1:PRINT"";S;"SUMMATION:"
  70. 660 IFLEN(F$(F1,S))<1ORLEN(F$(F1,S))<LEN(R$)THEN690
  71. 670 FORF2=1TOLEN(F$(F1,S))-LEN(R$)+1:IFMID$(F$(F1,S),F2,LEN(R$))=R$THENGOSUB770
  72. 680 NEXTF2
  73. 690 NEXTS
  74. 700 PRINT"[147]":IFF=0THENPRINT" ";R$;"[146] NOT FOUND"
  75. 710 PRINT"PRINT LIST TO1[146] SCREEN   2[146] TAPE/DISK"
  76. 720 PRINT"3[146] PRINTER  4[146] ABORT"
  77. 730 IFC1ORC4ORC6THENPRINT"CAUTION: FILES OPEN"
  78. 740 INPUTGH
  79. 750 ONGHGOSUB3410,810,1410:IFGH>3THEN RETURN
  80. 760 GOTO700
  81. 770 F=F+1:IFF3(F-1)=STHENF=F-1:RETURN
  82. 780 F3(F)=S:PRINT"";F:IFU>NTHENGOSUB510:RETURN
  83. 790 T=T+VAL(F$(U,S)):PRINT"                 "
  84. 800 PRINT"";T:GOSUB510:RETURN
  85. 810 IFY<>1THENRETURN
  86. 820 IFC6=1THENPRINT"[147]":GOTO920
  87. 830 GOSUB2320:PT$="SAVE TO[146] ":GOSUB3030
  88. 840 QX$="SAVE ":GOSUB2410:IFA$<>"Y"THENRETURN
  89. 850 IFSV$="D"THENOPEN6,8,3,"@0:"+C$+",S,W":PRINT#6,C$;CHR$(13);
  90. 860 IFSV$="T"THENOPEN6,1,1,C$:PRINT#6,C$;CHR$(13);
  91. 870 PRINT"[147]SAVING ";C$:PRINT#6,N+1;CHR$(13);:IFC=5ORC=3THENPRINT#6,B;CHR$(13);
  92. 880 IFC=9THENPRINT#6,F+1;CHR$(13);
  93. 890 FORA=0TON:IFFF$(A)=""THENPRINT#6,".";CHR$(13);
  94. 900 IFFF$(A)<>""THENPRINT#6,FF$(A);CHR$(13);
  95. 910 NEXTA
  96. 920 IFC=5THENGOSUB1740:RETURN
  97. 930 IFC=3THENRETURN
  98. 940 FORD=1TOF:PRINT"RECS SAVED";D
  99. 950 FORA=0TON:IFF$(A,F3(D))=""THENPRINT#6,".";CHR$(13);
  100. 960 IFF$(A,F3(D))<>""THENPRINT#6,F$(A,F3(D));CHR$(13);
  101. 970 NEXTA,D:C6=1:PRINTWQ$:GOSUB2420:IFA$="Y"THENC7=6
  102. 980 IFA$="Y"THENGOSUB2500:RETURN
  103. 990 RETURN
  104. 1000 FORD=1TOF:IFSV$="Y"THENPRINT#4,F3(D);
  105. 1010 FORA=P3TOP4:PRINT#4,CHR$(16)P$(A)F$(A,F3(D));:NEXTA:PRINT#4
  106. 1020 IFLU$="Y"THENFORX=1TOTT:PRINT#4,CHR$(99);:NEXTX:PRINT#4
  107. 1030 IFUL$="Y"THENFORX=1TO80:PRINT#4,CHR$(99);:NEXTX:PRINT#4
  108. 1040 IFI$="D"THENPRINT#4,CHR$(10);
  109. 1050 GETA$:IFA$="[133]"THENFORD=1TO1:NEXTD:GOTO1070
  110. 1060 NEXTD:PRINT#4,CHR$(10);:IFU<=NTHENPRINT#4,"TOTAL"CHR$(16)P$(U)T
  111. 1070 PRINT#4:PRINT#4:C4=1:PRINTWQ$:GOSUB2420:IFA$="Y"THENC7=4:GOSUB2490
  112. 1080 RETURN
  113. 1090 IFB=>KL-1THENGOSUB2560:RETURN
  114. 1100 PRINTX$:B=B+1:FORDD=BTOD+1STEP-1:REM INSERT
  115. 1110 FORA=0TON:F$(A,DD)=F$(A,DD-1):NEXTA:NEXTDD:GOTO1150
  116. 1120 IFD=BTHEN1150:REM DELETE
  117. 1130 PRINTX$:FORDD=DTOB-1:FORA=0TON:F$(A,DD)=F$(A,DD+1):NEXTA:NEXTDD
  118. 1140 GOSUB510:B=B-1:RETURN
  119. 1150 IFD>=BANDU$="REPLACE[146]"THENPRINT"CAN'T ";U$;" IT":RETURN
  120. 1160 GOSUB510:PRINT"ENTER NEW REC[146]";D;"                [146]"
  121. 1170 FORA=0TON:PRINT""FF$(A);"[146]";:INPUTF$(A,D):NEXTA:GOSUB510:RETURN
  122. 1180 D=1:ZX=1:IF Y<>1THENRETURN
  123. 1190 PRINT"[147]"
  124. 1191 PRINT"F1[146] ABORT  R[146] REPLACE  D[146] DELETE   I[146] INSERT G[146] GOTO";
  125. 1200 PRINT"   C[146] COPY     P[146] PREVIOUS M[146] MOVE   S[146] SEARCH";
  126. 1202 PRINT" X[146] CONFIG   H[146] HELP"
  127. 1205 IFA$="H"THEN1240
  128. 1210 IFX1=2ANDD>1THENPRINT"[147]"
  129. 1211 PRINT"                                       "
  130. 1212 PRINT"                                       "
  131. 1213 PRINT"                                       [145][145][145]":PRINT
  132. 1214 PRINTM1$;D;M2$:PRINT
  133. 1220 FORA=0TON:PRINT"";FF$(A);": [146]";:PRINTF$(A,D):NEXTA
  134. 1230 IFZX=0THENR=1:ZX=1:RETURN
  135. 1240 GETA$:IFA$=""THEN1240
  136. 1250 V$=A$
  137. 1260 IFA$="R"THENU$="REPLACE[146]":GOSUB1620
  138. 1270 IFA$="[133]"THENGOSUB2520:A=0:RETURN
  139. 1280 IFA$="D"THENU$="DELETE[146]":GOSUB1620
  140. 1290 IFA$="I"THENU$="INSERT AS[146]":GOSUB1620
  141. 1300 IFA$="M"THENU$="MOVE[146]":GOSUB1620
  142. 1310 IFA$="G"THENGOSUB1380
  143. 1320 IFA$="S"THENGOSUB3290
  144. 1330 IFA$="C"THENU$="COPY[146]":GOSUB1620
  145. 1335 IFA$="X"THENGOSUB4500:GOTO1210
  146. 1337 IFA$="H"THEN1191
  147. 1340 IFA$="P"ANDD>1THEND=D-1:PRINT"[147]":GOTO1210
  148. 1350 IFR=1THENR=0:GOTO1210
  149. 1360 IFD>=BTHEN1240
  150. 1370 D=D+1:GOTO1210
  151. 1380 INPUT" GOTO WHERE[146]";D:R=1:IFC=4ANDD>BTHEND=B
  152. 1390 IFZX=0ANDD>BTHEND=B
  153. 1400 PRINT"[147]":RETURN
  154. 1410 IFY<>1THENRETURN
  155. 1420 IFC4=1THENPRINT"[147]":GOTO1540
  156. 1430 GOSUB2320:PRINT"NAME FOR LIST[146]":INPUTC$:INPUT"SPACING  S[146] OR D[146]";I$
  157. 1440 IFC=8THENINPUT"FROM REC #";P1:INPUT"TO REC #";P2:IFP2>BTHENP2=B
  158. 1450 INPUT"PRINT REC#'S (Y/N)";SV$:GOSUB2570
  159. 1460 INPUT"FULL UNDERLINE[160](Y/N)";UL$:PRINT"SHORT UNDERLINE (Y/N)":INPUTLU$
  160. 1470 PRINT"ENTER 01-80 OR RETURN[146]":FORA=P3TOP4:PRINT"FIELD";A;"AT";
  161. 1480 INPUTP$(A):NEXTA
  162. 1490 QX$="PRINT":GOSUB2410:IFA$<>"Y"ANDC=9THENPRINT"[147]":RETURN
  163. 1500 IFA$<>"Y"THENRETURN
  164. 1510 OPEN4,4:PRINT#4,C$:PRINT#4
  165. 1520 FORA=P3TOP4:PRINT#4,CHR$(16)P$(A)FF$(A);:NEXTA:PRINT#4,CHR$(13)
  166. 1530 IFUL$="Y"THENFORX=1TO80:PRINT#4,CHR$(99);:NEXTX:PRINT#4
  167. 1540 PRINT" F1[146] ABORTS PRINTOUT":IFC=9THEN1000
  168. 1550 FORD=P1TOP2:IFSV$="Y"THENPRINT#4,D;
  169. 1560 FORA=P3TOP4:PRINT#4,CHR$(16)P$(A)F$(A,D);:NEXTA:PRINT#4
  170. 1570 IFLU$="Y"THENFORX=1TOTT:PRINT#4,CHR$(99);:NEXTX:PRINT#4
  171. 1580 IFUL$="Y"THENFORX=1TO80:PRINT#4,CHR$(99);:NEXTX:PRINT#4
  172. 1590 IFI$="D"THENPRINT#4,CHR$(10);
  173. 1600 GETA$:IFA$="[133]"THENFORD=1TO1
  174. 1610 NEXTD:PRINT#4:C4=1:RETURN
  175. 1620 V$=A$:A$=STR$(D)
  176. 1630 PRINTU$;" WHAT RECORD  (N[146] TO ABORT)":INPUTA$
  177. 1640 IFVAL(A$)<1THENA$=V$:RETURN
  178. 1650 D=VAL(A$):IFD>BTHEND=B
  179. 1660 IFV$="I"THEN1680
  180. 1670 IFD>B-1THENPRINT"   MAXIMUM=[146]";B-1;"     [146]":GOTO1630
  181. 1680 R=1:IFV$="D"THENGOSUB1120
  182. 1690 IFV$="M"THENPRINTX$:GOSUB2270
  183. 1700 IFV$="R"THENGOSUB1150
  184. 1710 IFV$="I"THENGOSUB1090
  185. 1720 IFV$="C"THENGOSUB2140
  186. 1730 A$=V$:RETURN
  187. 1740 FORD=1TOB-1:PRINT"RECS SAVED";D:FORA=0TON
  188. 1750 IFF$(A,D)=""THENPRINT#6,".";CHR$(13);
  189. 1760 IFF$(A,D)<>""THENPRINT#6,F$(A,D);CHR$(13);
  190. 1770 NEXTA:NEXTD:C6=1
  191. 1780 PRINTWQ$:GOSUB2420:IFA$="Y"THENC7=6:GOSUB2500
  192. 1790 RETURN
  193. 1800 PRINT"[147]";:PT$="LOAD FROM[146] ":GOSUB3030:QX$="LOAD":GOSUB2410:IFA$<>"Y"THENRETURN
  194. 1810 PRINT"[147]OPENING FILE[146]":IFSV$="T"THENOPEN1,1,0,C$
  195. 1820 IFSV$="D"THENOPEN1,8,2,C$+",S,R"
  196. 1830 INPUT#1,C$,NN,D:GOSUB2330:GOSUB2350:C1=1
  197. 1840 IFNN-1<NTHENPRINT"FIELDS IN FILE < FIELDS IN MEMORY FILE[146]"
  198. 1850 IFNN-1>NTHENPRINT"FIELDS IN FILE > FIELDS IN MEMORY FILE[146]"
  199. 1860 IFB+D>KLORNN-1>LKTHENPRINT"EXCEEDS CURRENT ARRAY OF ";KL-1;" X ";LK+1
  200. 1870 IFB+D>KLORNN-1>LKTHENFORA=1TO15:GOSUB510:NEXT:C1=0:CLOSE1:RETURN
  201. 1880 D=1:NN=NN-1:PRINT"FILE:[146] ";C$:PRINT"FIELDS ARE:[146]"
  202. 1882 FOR A=0TONN:INPUT#1,J$(A):PRINTJ$(A):NEXTA:PRINT""
  203. 1890 W=0:PRINT"   Y[146]-LOAD   F1[146]-ABORT"
  204. 1900 PRINT"NOTE: LOAD WILL USE FIELD NAMES OF            INCOMING FILE"
  205. 1910 GETA$:IFA$=""THEN1910
  206. 1920 PRINT"[147]":IFA$<>"Y"THENC1=0:CLOSE1:RETURN
  207. 1930 :N=NN:FORA=0TON:FF$(A)=J$(A):NEXTA
  208. 1940 PRINT"RECORDS READ[146]";D
  209. 1950 FORA=0TON:F$(A,B)="":INPUT#1,F$(A,B):IFLEFT$(F$(A,B),3)="@@@"THENA=N:W=1
  210. 1960 NEXTA:IFW=1THEN1980
  211. 1970 D=D+1:B=B+1:GOTO1940
  212. 1980 CLOSE1:Y=1:A=0:C1=0:RETURN
  213. 1990 PRINT"[147]STAND BY..":X=FRE(9):PRINT"  BYTES FREE=";X
  214. 2000 QX$="[157][157][157][157]        ":GOSUB2410:RETURN
  215. 2010 PRINT"[147]ENTER GOTO180[146] AND PRESS RETURN TO RETAINCURRENT FILE IN MEMORY"
  216. 2012 PRINT"IF YOU WISH TO ERASE CURRENT FILE IN"
  217. 2013 PRINT"MEMORY, ENTER RUN[146] AND PRESS RETURN.":PRINT
  218. 2014 PRINT"BUT...BE SURE YOU HAVE CLOSED[146] ALL"
  219. 2015 PRINT "OPEN FILES FIRST.  TO DO THIS, ENTER"
  220. 2016 PRINT"GOTO 180[146] AND PRESS RETURN AND CHOOSE"
  221. 2017 PRINT"MENU ITEM 13[146] TO CLOSE THE OPEN FILES":END
  222. 2020 IF Y<>1THENRETURN
  223. 2030 GOSUB2320:PRINT"SORT WILL DESTROY THE FILE CURRENTLY IN MEMORY.[146]";
  224. 2032 PRINT"  ABORT AT [146]ABORT PROMPT BELOW ANDSAVE FILE FIRST.[146]"
  225. 2034 INPUT"SORT WHAT FIELD";Z:IFZ>NTHENGOSUB5000:RETURN
  226. 2040 QX$="INDEX ":PT$="SAVE TO[146] ":GOSUB3030:GOSUB840:IFA$<>"Y"THENRETURN
  227. 2050 F$(Z,B)="ZZZ":E=1:PRINT"[147]SORTING";B-1;" RECORDS[146]"
  228. 2060 I=1:FORJ=2TOB:IFF$(Z,I)<F$(Z,J)THEN2080
  229. 2070 I=J
  230. 2080 NEXTJ
  231. 2090 IFF$(Z,I)="ZZZ"THEN2120
  232. 2100 PRINT"";E;" RECS SORTED":FORA=0TON
  233. 2110 S$(A,1)=F$(A,I):PRINT#6,S$(A,1);CHR$(13);:NEXTA:E=E+1:F$(Z,I)="ZZZ":GOTO2060
  234. 2120 PRINT"CLOSING":FORA=0TON:PRINT#6,"@@@";CHR$(13);:NEXTA
  235. 2130 CLOSE6:QX$="[157][157][157]SORT IS DONE":GOSUB2410:RETURN
  236. 2140 FORA=0TON:CC$(A,1)=F$(A,D):NEXTA:IFB=>KL-1THENGOSUB2560:A$=V$:RETURN
  237. 2150 PRINT"[145]":PRINT"   SPACE  G  P      F7 TO PLACE)[146]"
  238. 2160 GETA$:IFA$=""THEN2160
  239. 2170 IFA$="[136]"THEN2220
  240. 2180 ZX=0:IFA$="G"THENGOSUB1380
  241. 2190 IFA$="P"THENPRINT"[147]":D=D-1:IFD<1THEND=1
  242. 2200 IFA$=" "THEND=D+1:IFD>BTHEND=B
  243. 2210 ZX=0:GOSUB1210:ZX=1:GOTO2150
  244. 2220 PRINT"[145]":PRINTU$;" TO REC#                 ":INPUTD:PRINTX$:IFD>BTHEND=B
  245. 2230 IFA$="M"THENGOTO2300
  246. 2240 B=B+1:FORDD=BTOD+1STEP-1:FORA=0TON:F$(A,DD)=F$(A,DD-1):NEXTA:NEXTDD
  247. 2250 FORA=0TON:F$(A,D)=CC$(A,1):NEXTA
  248. 2260 PRINTU$;" COMPLETE[146]":ZX=1:A$=V$:GOSUB510:RETURN
  249. 2270 FORA=0TON:CC$(A,1)=F$(A,D):NEXTA:IFB=>KL-1THENGOSUB2560:A$=V$:RETURN
  250. 2280 FORDD=DTOB-1:FORA=0TON:F$(A,DD)=F$(A,DD+1):NEXTA:NEXTDD
  251. 2290 B=B-1:GOSUB510:GOTO2150
  252. 2300 B=B+1:FORDD=BTOD+1STEP-1:FORA=0TON:F$(A,DD)=F$(A,DD-1):NEXTA:NEXTDD
  253. 2310 FORA=0TON:F$(A,D)=CC$(A,1):NEXTA:GOTO2260
  254. 2320 PRINT"[147]FIELDS ARE:":FORA=0TON:PRINT"";A;"[146]";FF$(A):NEXTA:IFC=6THENRETURN
  255. 2330 IFC=6THENPRINT"";D;"RECS. ";NN;"FIELDS":RETURN
  256. 2340 IFC<>6THENPRINT"";B;"RECS. ";N+1;"FIELDS":RETURN
  257. 2350 IFY=1THENRETURN
  258. 2352 IFC<>1THENGOTO2375
  259. 2353 PRINT"[147]PLEASE ENTER THE NUMBER OF FIELDS[146] EACH  RECORD WILL HAVE"
  260. 2355 INPUT LK:X$="REARRANGING[146][145]"
  261. 2360 PRINT"BELOW YOU MUST TELL ME THE APPROX. NO.  OF RECORDS[146]";
  262. 2361 PRINT" THE FILE WILL CONTAIN. THE   HIGHER THE NUMBER OF FIELDS, THE";
  263. 2363 PRINT" LOWER  THE NUMBER OF RECORDS YOU CAN HAVE DUE  TO MEMORY ";
  264. 2365 PRINT"LIMITATIONS.  ASSUMING YOU    HAVE 6 FIELDS OR LESS, YOU'LL ";
  265. 2366 PRINT"PROBABLY  BE ABLE TO ENTER 150 BELOW.  IF WHEN    YOUR 150TH RECORD";
  266. 2367 PRINT" IS ENTERED THERE      APPEARS TO BE ENOUGH MEMORY FOR MORE    (CHE";
  267. 2368 PRINT"CK MEMORY WITH MENU ITEM 11), SAVE  THE FILE, BREAK FROM THE PROGR";
  268. 2369 PRINT"AM, RE-RUNIT AND LOAD[146] THE FILE, AT WHICH POINT YOUCAN ENTER A";
  269. 2370 PRINT" LARGER NUMBER."
  270. 2372 INPUT"HOW MANY RECORDS[146] DO YOU WISH THE FILE   TO CONTAIN";KL
  271. 2373 GOTO 2380
  272. 2375 PRINT"ENTER A GREATER NUMBER THAN THE"
  273. 2376 PRINT"CURRENT NO. OF RECORDS IN THIS FILE IF"
  274. 2377 PRINT"YOU WISH TO ADD TO IT.  OTHERWISE"
  275. 2378 PRINT"ENTER THE ABOVE NO.":INPUT"DIMENSION FOR HOW MANY RECORDS";KL
  276. 2379 INPUT"ENTER THE NO. OF FIELDS[146] SHOWN ABOVE AND PRESS RETURN";LK
  277. 2380 KL=KL+1:LK=LK-1:DIMF$(LK,KL),FF$(LK),F1(KL),F3(KL),S$(LK,1)
  278. 2390 DIMCC$(LK,1),U(LK),P$(LK):PRINT"[147]";
  279. 2400 VL=36878:VO=36874:Y=1:B=1:RETURN
  280. 2410 PRINT"  Y[146] ";QX$;"  F1[146] ABORT"
  281. 2420 GETA$:IFA$="Y"ORA$="[133]"THENRETURN
  282. 2430 GOTO2420
  283. 2440 C7=9:PRINT"[147]FILES OPEN ARE:[146]":IFC1THENPRINT" 1[146] TAPE LOAD"
  284. 2450 IFC4THENPRINT" 4[146] PRINTER"
  285. 2460 IFC6THENPRINT" 6[146] TAPE/DISK SAVE"
  286. 2470 PRINT" RETURN[146] TO CLOSE NONE"
  287. 2480 INPUT"CLOSE WHICH FILE";C7:IFC7=1THENCLOSE1:C1=0
  288. 2490 IFC7=4THENPRINT#4:CLOSE4:C4=0
  289. 2500 IFC7=6THENFORA=0TON:PRINT#6,"@@@";CHR$(13);:NEXTA:PRINT#6:CLOSE6:C6=0
  290. 2510 RETURN
  291. 2520 PRINT"RETURNING TO MENU":FORD=B+1TOKL:FORA=0TON:F$(A,D)="":NEXTA,D:RETURN
  292. 2530 IF Y<>1THEN RETURN
  293. 2540 GOSUB2320:PRINT"[145]ENTER NEW NAME        OR PRESS RETURN[146]":PRINT
  294. 2550 FORA=0TON:PRINT"FIELD";A;:INPUTFF$(A):NEXTA:RETURN
  295. 2560 PRINT"ARRAY FULL-CAN'T DO[146]":FORA=1TO10:GOSUB510:NEXTA:RETURN
  296. 2570 INPUT"FROM FIELD";P3:INPUT"THRU FIELD";P4
  297. 2580 INPUT"CALC FIELD LENGTHS";P1$:IFP1$<>"Y"THENRETURN
  298. 2590 PRINT"[147]CALCULATING LENGTHS[146]"
  299. 2600 FORA=P3TOP4:FORD=1TOB-1:IFLEN(F$(A,D))>U(A)THENU(A)=LEN(F$(A,D))
  300. 2610 NEXTD:PRINT"FD#";A;" IS";U(A):NEXTA
  301. 2620 INPUT"CALC PRINT POSITIONS";P1$:IFP1$="Y"THEN2650
  302. 2630 PRINT"FIELD LENGTHS ARE:":FORA=P3TOP4:PRINT"FIELD";A;" IS";U(A):NEXTA
  303. 2640 PRINT"WRITE THESE DOWN":GOSUB2410:RETURN
  304. 2650 U2=0:P$(P3)="01":IFSV$="Y"THENU2=U2+6:P$(P3)="05"
  305. 2660 TT=0:IFSV$="Y"THENTT=6
  306. 2670 FORA=P3TOP4:TT=TT+U(A)+1:NEXTA:PRINT"LINE LENGTH IS";TT
  307. 2680 PRINT"FD#";P3;" AT ";P$(P3)
  308. 2690 FORA=P3+1TOP4:U2=U2+U(A-1)+2:P$(A)=STR$(U2)
  309. 2700 IFU2<10THENP$(A)="0"+MID$(P$(A),2,2)
  310. 2710 IFLEN(P$(A))>2THENP$(A)=MID$(P$(A),2,2)
  311. 2720 PRINT"FD#";A;" AT ";P$(A):NEXTA:RETURN
  312. 2730 QX$="[157][157][157][157]     ":IFUD$<>"Y"THENRETURN
  313. 2740 PRINT"[147] S[146]CREEN ONLY   P[146]RINTER ALSO  F1[146] ABORT"
  314. 2750 GETDR$:IFDR$=""THEN2750
  315. 2760 IFDR$="[133]"THENRETURN
  316. 2770 PRINT"STAND BY...":OPEN1,8,0,"$0":GET#1,A$,B$:IFDR$="P"THENOPEN4,4
  317. 2780 PRINT"[145]F1[146]-ABORT   ":PRINT"SPACE[146]-START/STOP"
  318. 2790 GET#1,A$,B$:GET#1,A$,B$:O=0:IFA$<>""THENO=ASC(A$)
  319. 2800 IFB$<>""THENO=O+ASC(B$)*256
  320. 2810 PRINT"";MID$(STR$(O),2);TAB(3);"[146]";
  321. 2820 IFDR$="P"THENPRINT#4,MID$(STR$(O),2);CHR$(16)"03";
  322. 2830 GET#1,B$:IFST<>0THEN2930
  323. 2840 IFB$<>CHR$(34)THEN2830
  324. 2850 GET#1,B$:IFB$<>CHR$(34)THENPRINTB$;:IFDR$="P"THENPRINT#4,B$;
  325. 2860 IFB$<>CHR$(34)THEN2850
  326. 2870 GET#1,B$:IFB$=CHR$(32)THEN2870
  327. 2880 PRINTTAB(18);:K$=""
  328. 2890 K$=K$+B$:GET#1,B$:IFB$<>""THEN2890
  329. 2900 PRINT""LEFT$(K$,3):IFDR$="P"THENPRINT#4,CHR$(16)"18";LEFT$(K$,3)
  330. 2910 GETT$:IFT$<>""THEN2990
  331. 2920 IFST=0THEN2790
  332. 2930 PRINT" BLOCKS FREE":IFDR$="P"THENPRINT#4,"BLOCKS FREE"
  333. 2940 CLOSE1:IFDR$="P"THENPRINT#4:CLOSE4
  334. 2950 GOSUB2410:RETURN
  335. 2960 QX$="[157][157][157][157]      ":PRINT"[147]":IFUD$<>"Y"THENRETURN
  336. 2970 GET#15,A$:PRINTA$;:IFA$<>CHR$(13)GOTO2970
  337. 2980 PRINT:GOTO2950
  338. 2990 IFT$="[133]"THEN2930
  339. 3000 GETT$:IFT$="[133]"THEN2930
  340. 3010 IFT$=" "THEN2920
  341. 3020 GOTO3000
  342. 3030 PRINTPT$;"D[146]ISK   T[146]APE"
  343. 3040 GETSV$:IFSV$=""THEN3040
  344. 3050 IFSV$<>"D"ANDSV$<>"T"THEN3040
  345. 3060 C$="N":PRINT"ENTER FILE NAME.  DISK USERS CAN ENTER "
  346. 3062 PRINT"@DIR[146] TO VIEW DIRECTORY":INPUTC$
  347. 3070 IFC$="@DIR"THENGOSUB2730
  348. 3080 IFC$="@DIR"THEN3060 
  349. 3090 RETURN
  350. 3100 IFY<>1THENRETURN
  351. 3110 GOSUB2320:X$=CHR$(13):C$="N":INPUT"INDEX[146] WHICH FIELD";U
  352. 3112 IFU>NTHENGOSUB5000:RETURN
  353. 3120 PRINT"TO 1[146] SCREEN  2[146] TAPE  3[146] DISK  4[146] PRINTER":INPUTGH
  354. 3130 INPUT"NAME FOR INDEX";LD$:IFLD$="@DIR"THENGOSUB2730:GOTO3130
  355. 3140 C$=LD$:QX$="INDEX":GOSUB2410:IFA$<>"Y"THENRETURN
  356. 3150 IF C6=1THENPRINT"CAN'T DO - FILE OPEN[146]":FORA=1TO6:GOSUB510:NEXTA:RETURN
  357. 3160 IFGH=2THENOPEN6,1,1,C$:PRINT#6,C$;X$;1;X$;B;X$;FF$(U);X$;
  358. 3170 IFGH=3THENOPEN6,8,5,"@0:"+C$+",S,W":PRINT#6,C$;X$;1;X$;B;X$;FF$(U);X$;
  359. 3180 PRINT"[147]";F$(U,1):IFGH=4THENOPEN4,4:PRINT#4,C$:PRINT#4:PRINT#4,F$(U,1)
  360. 3190 IFGH=2ORGH=3THENPRINT#6,F$(U,1);X$;
  361. 3200 FORD=2TOB-1:FORA=1TOD-1:IFF$(U,D)=F$(U,A)THEN3240
  362. 3210 NEXTA:GETA$:IFA$<>""THENA=D-1:D=B-1:PRINT"ABORTED - PRESS F1[146]":GOTO3260
  363. 3220 PRINTF$(U,D):IFGH=4THENPRINT#4,F$(U,D)
  364. 3230 IFGH=2ORGH=3THENPRINT#6,F$(U,D);X$;
  365. 3240 NEXTD
  366. 3250 PRINT"COMPLETED - PRESS F1[146]"
  367. 3260 IFGH=4THENPRINT#4:CLOSE4
  368. 3270 IFGH=2ORGH=3THENPRINT#6,"@@@";X$:CLOSE6
  369. 3280 GOSUB2420:RETURN
  370. 3290 GOSUB2320:INPUT"SEARCH FOR (@@@[146] ABORT) ";R$
  371. 3300 IF R$="@@@"THEN PRINT"[147]":D=D-1:RETURN
  372. 3310 INPUT"SEARCH ON FIELD";F1:IFF1>NTHENGOSUB5000:GOTO3310
  373. 3320 PRINT"[147]SEARCHING FOR           ";R$
  374. 3330 IF D=>B-1THEN3400
  375. 3340 FOR S=D+1TOB-1
  376. 3350 IFLEN(F$(F1,S))<1ORLEN(F$(F1,S))<LEN(R$)THEN3390
  377. 3360 FORF2=1TOLEN(F$(F1,S))-LEN(R$)+1
  378. 3370 IF MID$(F$(F1,S),F2,LEN(R$))=R$THEND=S-1:FORS=1TO2:NEXTS:PRINT"[147]":RETURN
  379. 3380 NEXTF2
  380. 3390 NEXTS
  381. 3400 PRINT"NOT FOUND":GOSUB510:FORO=1TO300:NEXTO:D=D-1:RETURN
  382. 3410 D=1:PRINT"[147]"
  383. 3411 PRINT" G[146]OTO  P[146]REV.  H[146]ELP  X[146]=CONFIG  F1[146]=ABORT"
  384. 3413 IFA$="H"THEN3450
  385. 3420 IFX1=2ANDD>1THENPRINT"[147]"
  386. 3421 PRINT"                                       "
  387. 3422 PRINT"                                       "
  388. 3423 PRINT"                                       [145][145][145]":PRINT
  389. 3424 PRINTM1$;F3(D);M4$:PRINT
  390. 3430 FOR A=0TON:PRINT"";FF$(A);": [146]";F$(A,F3(D)):NEXTA
  391. 3440 IFD=FTHENPRINT"                                      "
  392. 3442 IFD=FTHENPRINT"NO. FOUND: ";F;" SUMMATION: ";T
  393. 3444 IFD=FTHENPRINT"                                      "
  394. 3450 GETA$:IFA$=""THEN3450
  395. 3460 IFA$="[133]"THENPRINT"[147]":RETURN
  396. 3465 IFA$="X"THENGOSUB4500:GOTO3420
  397. 3467 IFA$="H"THEN3411
  398. 3470 IFA$="P"AND D>1THEND=D-1:PRINT"[147]":GOTO3420
  399. 3480 IFA$="G"THENPRINT"GOTO WHERE[146]":INPUTD:IFD>FTHEND=F:PRINT"[147]":GOTO3420
  400. 3490 IF A$="G"THENPRINT"[147]":GOTO3420
  401. 3500 IFD>FTHEN3450
  402. 3510 D=D+1:GOTO3420
  403. 3520 PRINT"[147]  COLOR CHANGE":PRINT"PRESS:":PRINT" F1[146] - EXIT"
  404. 3530 PRINT" F3[146] - BACKGROUND"
  405. 3540 PRINT" F4[146] - BOARDER":PRINT" F5[146] - CHARACTER"
  406. 3550 C7=PEEK(53281):C8=PEEK(53280):C9=PEEK(646)
  407. 3560 GET CL$:IFCL$=""THEN3560
  408. 3570 IFCL$="[134]"THENC7=C7+1:IFC7>15THENC7=0
  409. 3580 IFCL$="[134]"THENPOKE53281,C7:GOTO3560
  410. 3590 IFCL$="[138]"THENC8=C8+1:IFC8>15THENC8=0
  411. 3600 IFCL$="[138]"THENPOKE53280,C8:GOTO3560
  412. 3610 IFCL$="[135]"THENC9=C9+1:IFC9>15THENC9=0
  413. 3620 IFCL$="[135]"THENPOKE646,C9:GOTO3520
  414. 3630 IFCL$="[133]"THENRETURN
  415. 3640 GOTO3560 
  416. 3650 PRINT"[147]  SEND DISK COMMAND[146]"
  417. 3660 PRINT"SAMPLE SYNTAX (USE QUOTES AT                          START AND END)"
  418. 3670 PRINT"SCRATCH FILE[146]       S0:FILENAME"
  419. 3680 PRINT"RENAME FILE[146]        R0:NEWNAME=OLDNAME"
  420. 3690 PRINT"DUP A FILE[146]         C0:NEWFILE=0:OLDFILE"
  421. 3700 PRINT"INITIALIZE DRIVE[146]   I"
  422. 3710 PRINT"VALIDATE DISK[146]      V"
  423. 3715 PRINT"FORMAT NEW DISK[146]    N0:DISKNAME,ID"
  424. 3720 PRINT"ENTER STRING TO SEND (BEGIN AND END WITH DOUBLE QUOTE)"
  425. 3722 PRINT"OR PRESS RETURN[146] TO RETURN TO MENU"
  426. 3730 FM$="X":INPUT FM$
  427. 3740 IF LEFT$(FM$,1)="S"THEN3800 
  428. 3750 IF LEFT$(FM$,1)="R"THEN3840 
  429. 3760 IF LEFT$(FM$,1)="C"THEN3870 
  430. 3770 IF LEFT$(FM$,1)="I"THEN PRINT#15,"I":RETURN
  431. 3780 IF LEFT$(FM$,1)="V"THEN3910 
  432. 3785 IF LEFT$(FM$,1)="X"THEN RETURN
  433. 3787 IF LEFT$(FM$,1)="N"THEN3950
  434. 3790 PRINT"INVALID - ABORTED[146]":FORT=1TO1000:NEXT:RETURN
  435. 3800 QX$="SCRATCH":PRINT"[147]SCRATCH THIS FILE":PRINTFM$:PRINT""
  436. 3810 GOSUB2410
  437. 3820 IFA$<>"Y"THEN RETURN
  438. 3830 PRINT"SCRATCHING FILE":PRINT#15,FM$:GOSUB3940:GOSUB2960:RETURN
  439. 3840 QX$="RENAME":PRINT"[147]RENAME A FILE":PRINTFM$:PRINT"":GOSUB2410
  440. 3850 IFA$<>"Y"THENRETURN
  441. 3860 PRINT"RENAMING THE FILE":PRINT#15,FM$:GOTO3940
  442. 3870 QX$="DUPLICATE":PRINT"[147]DUPLICATE A FILE[146]":PRINTFM$:PRINT""
  443. 3880 GOSUB2410
  444. 3890 IFA$<>"Y"THEN RETURN
  445. 3900 PRINT"DUPLICATING FILE":PRINT#15,FM$:GOTO3940
  446. 3910 QX$="VALIDATE":PRINT"[147]VALIDATE DISK[146]":GOSUB2410
  447. 3920 IFA$<>"Y"THENRETURN
  448. 3930 PRINT"VALIDATING DISK":PRINT#15,FM$:GOTO3940
  449. 3940 FORT=1 TO 2500:NEXT T:RETURN
  450. 3950 QX$="BEGIN FORMAT":PRINT"[147]CAUTION[146]: ERASES DISK ... PUT BLANK DISK ";
  451. 3951 PRINT"IN DRIVE NOW!!!"
  452. 3952 PRINT"FORMAT DISK NOW AS ";FM$:PRINT
  453. 3953 GOSUB2410:IFA$<>"Y"THEN RETURN
  454. 3955 PRINT"FORMATTING DISK":PRINT#15,FM$:GOSUB3940:GOSUB2960:RETURN
  455. 4000 PRINT"                                       "
  456. 4001 PRINT"                                       "
  457. 4002 PRINT"                                       [145][145][145]":PRINT
  458. 4003 RETURN
  459. 4500 PRINT"[147]SYSTEM CONFIGURATION"
  460. 4505 PRINT" 1[146] - DISPLAY FORMAT":PRINT" 2[146] - RECORD INPUT DEFAULT"
  461. 4518 N1=0:INPUT"CHANGE WHICH CONFIGURATION ABOVE";N1:IFN1=0THENRETURN
  462. 4520 IFN1=1THEN4605
  463. 4522 GOTO4650
  464. 4605 PRINT"[147]RECORD DISPLAY FORMAT:[146]
  465. 4607 [153]"ENTER  1 WAIT FOR SCROLLING DISPLAY."
  466. 4608 [153]"       2 WAIT FOR 1 RECORD PER SCREEN."
  467. 4612 [153]"CURRENT DISPLAY FORMAT IS:":[139]X1[178]1[167][153]" SCROLLINGWAIT"
  468. 4614 [139]X1[178]2[167][153]" 1 PER SCREENWAIT"
  469. 4618 [133]X1:[153]"LOAD";:[142]
  470. 4650 [153]"LOADRECORD INPUT DEFAULT:"
  471. 4655 [153]"ENTER  1 WAIT IF YOU WISH TO BE ABLE TO"
  472. 4658 [153]"JUST PRESS RETURN ON A FIELD WHEN YOU"
  473. 4662 [153]"ARE ENTERING RECORDS WITH  CREATE WAIT OR"
  474. 4665 [153]" ADD RECORDS WAIT ROUTINES TO MAKE THE"
  475. 4668 [153]"FIELD THE SAME AS THAT FIELD IN THE"
  476. 4670 [153]"PREVIOUS RECORD."
  477. 4675 [153]"ENTER  2 WAIT IF YOU WISH TO PRESS RETURN"
  478. 4678 [153]"AND LEAVE THAT FIELD BLANK.  (NOTE THAT THE PROGRAM PUTS A PERIOD ";
  479. 4679 [153]" IN A BLANK   FIELD.)"
  480. 4685 [153]"CURRENT ENTRY DEFAULT IS: ";:[139]X2[178]1[167][153]"COPY PREVIOUS FIELDWAIT"
  481. 4688 [139] X2[178]2[167][153]"FIELD BLANKWAIT"
  482. 4690 [133]"ENTER THE ENTRY DEFAULT YOU WISH";X2:[142]
  483. 4700 [153]"LOAD * * * H E L P * * *":[153]"FOR COMPLETE INSTRUCTION YOU SHOULD"
  484. 4705 [153]"READ THE FILE CALLED DBASE64.INSTRWAIT."
  485. 4710 [153]"USING A SEQUENTIAL FILE READER-"
  486. 4715 [153]"PRINTER."
  487. 4785 [153]"AUTHORWAIT: DICK JACOBS - BALLSTON SPA, NY"
  488. 4797 [153]"PRESS ANY KEY TO RETURN"
  489. 4798 [161]A$:[139]A$[178]""[167]4798
  490. 4799 [142]
  491. 5000 [153]"NO SUCH FIELD - MAX. = WAIT";N:[129]A[178]1[164]12:[141]510:[130]A:[142]
  492. 0 
  493.